home *** CD-ROM | disk | FTP | other *** search
/ Software Vault: The Gold Collection / Software Vault - The Gold Collection (American Databankers) (1993).ISO / cdr25 / me310.zip / UE310C.ZIP / EVAL.C < prev    next >
C/C++ Source or Header  |  1989-03-09  |  33KB  |  1,261 lines
  1. /*    EVAL.C:    Expresion evaluation functions for
  2.         MicroEMACS
  3.  
  4.     written 1986 by Daniel Lawrence                */
  5.  
  6. #include    <stdio.h>
  7. #include    "estruct.h"
  8. #include    "etype.h"
  9. #include    "edef.h"
  10. #include    "elang.h"
  11. #include    "evar.h"
  12.  
  13. PASCAL NEAR varinit()    /* initialize the user variable list */
  14.  
  15. {
  16.     register int i;
  17.  
  18.     for (i=0; i < MAXVARS; i++)
  19.         uv[i].u_name[0] = 0;
  20. }
  21.  
  22. PASCAL NEAR varclean()    /* initialize the user variable list */
  23.  
  24. {
  25.     register int i;
  26.  
  27.     for (i=0; i < MAXVARS; i++)
  28.         if (uv[i].u_name[0] != 0)
  29.             free(uv[i].u_value);
  30. }
  31.  
  32. char *PASCAL NEAR gtfun(fname)    /* evaluate a function */
  33.  
  34. char *fname;        /* name of function to evaluate */
  35.  
  36. {
  37.     register int fnum;        /* index to function to eval */
  38.     register int arg;        /* value of some arguments */
  39.     char arg1[NSTRING];        /* value of first argument */
  40.     char arg2[NSTRING];        /* value of second argument */
  41.     char arg3[NSTRING];        /* value of third argument */
  42.     static char result[2 * NSTRING];    /* string result */
  43. #if    ENVFUNC
  44.     char *getenv();            /* get environment string */
  45. #endif
  46.  
  47.     /* look the function up in the function table */
  48.     fname[3] = 0;    /* only first 3 chars significant */
  49.     mklower(fname);    /* and let it be upper or lower case */
  50. #if    BINARY
  51.     fnum = binary(fname, funval, NFUNCS);
  52.  
  53.     /* return errorm on a bad reference */
  54.     if (fnum == -1)
  55.         return(errorm);
  56. #else
  57.     for (fnum = 0; fnum < NFUNCS; fnum++)
  58.         if (strcmp(fname, funcs[fnum].f_name) == 0)
  59.             break;
  60.  
  61.     /* return errorm on a bad reference */
  62.     if (fnum == NFUNCS)
  63.         return(errorm);
  64. #endif
  65.  
  66.     /* if needed, retrieve the first argument */
  67.     if (funcs[fnum].f_type >= MONAMIC) {
  68.         if (macarg(arg1) != TRUE)
  69.             return(errorm);
  70.  
  71.         /* if needed, retrieve the second argument */
  72.         if (funcs[fnum].f_type >= DYNAMIC) {
  73.             if (macarg(arg2) != TRUE)
  74.                 return(errorm);
  75.  
  76.             /* if needed, retrieve the third argument */
  77.             if (funcs[fnum].f_type >= TRINAMIC)
  78.                 if (macarg(arg3) != TRUE)
  79.                     return(errorm);
  80.         }
  81.     }
  82.  
  83.  
  84.     /* and now evaluate it! */
  85.     switch (fnum) {
  86.         case UFADD:    return(int_asc(asc_int(arg1) + asc_int(arg2)));
  87.         case UFSUB:    return(int_asc(asc_int(arg1) - asc_int(arg2)));
  88.         case UFTIMES:    return(int_asc(asc_int(arg1) * asc_int(arg2)));
  89.         case UFDIV:    return(int_asc(asc_int(arg1) / asc_int(arg2)));
  90.         case UFMOD:    return(int_asc(asc_int(arg1) % asc_int(arg2)));
  91.         case UFNEG:    return(int_asc(-asc_int(arg1)));
  92.         case UFCAT:    strcpy(result, arg1);
  93.                 return(strcat(result, arg2));
  94.         case UFLEFT:    return(bytecopy(result, arg1, asc_int(arg2)));
  95.         case UFRIGHT:    arg = asc_int(arg2);
  96.                 if (arg > strlen(arg1))
  97.                     arg = strlen(arg1);
  98.                 return(strcpy(result,
  99.                     &arg1[strlen(arg1) - arg]));
  100.         case UFMID:    arg = asc_int(arg2);
  101.                 if (arg > strlen(arg1))
  102.                     arg = strlen(arg1);
  103.                 return(bytecopy(result, &arg1[arg-1],
  104.                     asc_int(arg3)));
  105.         case UFNOT:    return(ltos(stol(arg1) == FALSE));
  106.         case UFEQUAL:    return(ltos(asc_int(arg1) == asc_int(arg2)));
  107.         case UFLESS:    return(ltos(asc_int(arg1) < asc_int(arg2)));
  108.         case UFGREATER:    return(ltos(asc_int(arg1) > asc_int(arg2)));
  109.         case UFSEQUAL:    return(ltos(strcmp(arg1, arg2) == 0));
  110.         case UFSLESS:    return(ltos(strcmp(arg1, arg2) < 0));
  111.         case UFSGREAT:    return(ltos(strcmp(arg1, arg2) > 0));
  112.         case UFIND:    return(strcpy(result, fixnull(getval(arg1))));
  113.         case UFAND:    return(ltos(stol(arg1) && stol(arg2)));
  114.         case UFOR:    return(ltos(stol(arg1) || stol(arg2)));
  115.         case UFLENGTH:    return(int_asc(strlen(arg1)));
  116.         case UFUPPER:    return(mkupper(arg1));
  117.         case UFLOWER:    return(mklower(arg1));
  118.         case UFTRUTH:    return(ltos(asc_int(arg1) == 42));
  119.         case UFASCII:    return(int_asc((int)arg1[0]));
  120.         case UFCHR:    result[0] = asc_int(arg1);
  121.                 result[1] = 0;
  122.                 return(result);
  123.         case UFGTCMD:    cmdstr(getcmd(), result);
  124.                 return(result);
  125.         case UFGTKEY:    result[0] = tgetc();
  126.                 result[1] = 0;
  127.                 return(result);
  128.         case UFRND:    return(int_asc((ernd() % absv(asc_int(arg1))) + 1));
  129.         case UFABS:    return(int_asc(absv(asc_int(arg1))));
  130.         case UFSINDEX:    return(int_asc(sindex(arg1, arg2)));
  131.         case UFENV:
  132. #if    ENVFUNC
  133.                 return(fixnull(getenv(arg1)));
  134. #else
  135.                 return("");
  136. #endif
  137.         case UFBIND:    return(transbind(arg1));
  138.         case UFEXIST:    return(ltos(fexist(arg1)));
  139.         case UFFIND:
  140.                 return(fixnull(flook(arg1, TRUE)));
  141.          case UFBAND:    return(int_asc(asc_int(arg1) & asc_int(arg2)));
  142.          case UFBOR:    return(int_asc(asc_int(arg1) | asc_int(arg2)));
  143.          case UFBXOR:    return(int_asc(asc_int(arg1) ^ asc_int(arg2)));
  144.         case UFBNOT:    return(int_asc(~asc_int(arg1)));
  145.         case UFXLATE:    return(xlat(arg1, arg2, arg3));
  146.         case UFTRIM:    return(trimstr(arg1));
  147.         case UFSLOWER:    return(setlower(arg1, arg2), "");
  148.         case UFSUPPER:    return(setupper(arg1, arg2), "");
  149.     }
  150.  
  151.     meexit(-11);    /* never should get here */
  152. }
  153.  
  154. char *PASCAL NEAR gtusr(vname)    /* look up a user var's value */
  155.  
  156. char *vname;        /* name of user variable to fetch */
  157.  
  158. {
  159.     register int vnum;    /* ordinal number of user var */
  160.     register char *vptr;    /* temp pointer to function value */
  161.  
  162.     /* scan the list looking for the user var name */
  163.     for (vnum = 0; vnum < MAXVARS; vnum++) {
  164.         if (uv[vnum].u_name[0] == 0)
  165.             return(errorm);
  166.         if (strcmp(vname, uv[vnum].u_name) == 0) {
  167.             vptr = uv[vnum].u_value;
  168.             if (vptr)
  169.                 return(vptr);
  170.             else
  171.                 return(errorm);
  172.         }
  173.     }
  174.  
  175.     /* return errorm if we run off the end */
  176.     return(errorm);
  177. }
  178.  
  179. #if    BINARY
  180. char *PASCAL NEAR funval(i)
  181.  
  182. int i;
  183.  
  184. {
  185.     return(funcs[i].f_name);
  186. }
  187.  
  188. char *PASCAL NEAR envval(i)
  189.  
  190. int i;
  191.  
  192. {
  193.     return(envars[i]);
  194. }
  195.  
  196. PASCAL NEAR binary(key, tval, tlength)
  197.  
  198. char *key;        /* key string to look for */
  199. char *(PASCAL NEAR *tval)();    /* ptr to function to fetch table value with */
  200. int tlength;        /* length of table to search */
  201.  
  202. {
  203.     int l, u;    /* lower and upper limits of binary search */
  204.     int i;        /* current search index */
  205.     int cresult;    /* result of comparison */
  206.  
  207.     /* set current search limit as entire list */
  208.     l = 0;
  209.     u = tlength - 1;
  210.  
  211.     /* get the midpoint! */
  212.     while (u >= l) {
  213.         i = (l + u) >> 1;
  214.  
  215.         /* do the comparison */
  216.         cresult = strcmp(key, (*tval)(i));
  217.         if (cresult == 0)
  218.             return(i);
  219.         if (cresult < 0)
  220.             u = i - 1;
  221.         else
  222.             l = i + 1;
  223.     }
  224.     return(-1);
  225. }
  226. #endif
  227.  
  228. char *PASCAL NEAR gtenv(vname)
  229.  
  230. char *vname;        /* name of environment variable to retrieve */
  231.  
  232. {
  233.     register int vnum;    /* ordinal number of var refrenced */
  234.     static char result[2 * NSTRING];    /* string result */
  235.  
  236.     /* scan the list, looking for the referenced name */
  237. #if    BINARY
  238.     vnum = binary(vname, envval, NEVARS);
  239.  
  240.     /* return errorm on a bad reference */
  241.     if (vnum == -1)
  242.         return(errorm);
  243. #else
  244.     for (vnum = 0; vnum < NEVARS; vnum++)
  245.         if (strcmp(vname, envars[vnum]) == 0)
  246.             break;
  247.  
  248.     /* return errorm on a bad reference */
  249.     if (vnum == NEVARS)
  250.         return(errorm);
  251. #endif
  252.  
  253.     /* otherwise, fetch the appropriate value */
  254.     switch (vnum) {
  255.         case EVFILLCOL:    return(int_asc(fillcol));
  256.         case EVPAGELEN:    return(int_asc(term.t_nrow + 1));
  257.         case EVCURCOL:    return(int_asc(getccol(FALSE)));
  258.         case EVCURLINE: return(int_asc(getcline()));
  259.         case EVRAM:    return(int_asc((int)(envram / 1024l)));
  260.         case EVFLICKER:    return(ltos(flickcode));
  261.         case EVCURWIDTH:return(int_asc(term.t_ncol));
  262.         case EVCBFLAGS:    return(int_asc(curbp->b_flag));
  263.         case EVCBUFNAME:return(curbp->b_bname);
  264.         case EVCFNAME:    return(curbp->b_fname);
  265.         case EVSRES:    return(sres);
  266.         case EVDEBUG:    return(ltos(macbug));
  267.         case EVSTATUS:    return(ltos(cmdstatus));
  268.         case EVPALETTE:    return(palstr);
  269.         case EVASAVE:    return(int_asc(gasave));
  270.         case EVACOUNT:    return(int_asc(gacount));
  271.         case EVLASTKEY: return(int_asc(lastkey));
  272.         case EVCURCHAR:
  273.             return(curwp->w_dotp->l_used ==
  274.                     curwp->w_doto ? int_asc('\r') :
  275.                 int_asc(lgetc(curwp->w_dotp, curwp->w_doto)));
  276.         case EVDISCMD:    return(ltos(discmd));
  277.         case EVVERSION:    return(VERSION);
  278.         case EVPROGNAME:return(PROGNAME);
  279.         case EVLANG:    return(LANGUAGE);
  280.         case EVSEED:    return(int_asc(seed));
  281.         case EVDISINP:    return(ltos(disinp));
  282.         case EVWLINE:    return(int_asc(curwp->w_ntrows));
  283.         case EVCWLINE:    return(int_asc(getwpos()));
  284.         case EVTARGET:    saveflag = lastflag;
  285.                 return(int_asc(curgoal));
  286.         case EVSEARCH:    return(pat);
  287.         case EVTIME:    return(timeset());
  288.         case EVREPLACE:    return(rpat);
  289.         case EVMATCH:    return(fixnull(patmatch));
  290.         case EVKILL:    return(getkill());
  291.         case EVREGION:    return(getreg());
  292.         case EVCMODE:    return(int_asc(curbp->b_mode));
  293.         case EVGMODE:    return(int_asc(gmode));
  294.         case EVTPAUSE:    return(int_asc(term.t_pause));
  295.         case EVPENDING:
  296. #if    TYPEAH
  297.                 return(ltos(typahead()));
  298. #else
  299.                 return(falsem);
  300. #endif
  301.         case EVLWIDTH:    return(int_asc(llength(curwp->w_dotp)));
  302.         case EVLINE:    return(getctext());
  303.         case EVGFLAGS:    return(int_asc(gflags));
  304.         case EVRVAL:    return(int_asc(rval));
  305.         case EVREADHK:    return(fixnull(getfname(&readhook)));
  306.         case EVWRAPHK:    return(fixnull(getfname(&wraphook)));
  307.         case EVCMDHK:    return(fixnull(getfname(&cmdhook)));
  308.         case EVXPOS:    return(int_asc(xpos));
  309.         case EVYPOS:    return(int_asc(ypos));
  310.         case EVSTERM:    cmdstr(sterm, result);
  311.                 return(result);
  312.         case EVMODEFLAG:return(ltos(modeflag));
  313.         case EVSSCROLL:    return(ltos(sscroll));
  314.         case EVLASTMESG:return(lastmesg);
  315.         case EVHARDTAB:    return(int_asc(tabsize));
  316.         case EVSOFTTAB:    return(int_asc(stabsize));
  317.         case EVSSAVE:    return(ltos(ssave));
  318.         case EVFCOL:    return(int_asc(curwp->w_fcol));
  319.         case EVHSCROLL:    return(ltos(hscroll));
  320.         case EVHJUMP:    return(int_asc(hjump));
  321.         case EVBUFHOOK:    return(fixnull(getfname(&bufhook)));
  322.         case EVEXBHOOK:    return(fixnull(getfname(&exbhook)));
  323.         case EVWRITEHK:    return(fixnull(getfname(&writehook)));
  324.         case EVDIAGFLAG:return(ltos(diagflag));
  325.         case EVMSFLAG:    return(ltos(mouseflag));
  326.         case EVOCRYPT:    return(ltos(oldcrypt));
  327.     }
  328.     meexit(-12);    /* again, we should never get here */
  329. }
  330.  
  331. char *PASCAL NEAR fixnull(s)    /* Don't return NULL pointers! */
  332.  
  333. char *s;
  334.  
  335. {
  336.     if (s == NULL)
  337.         return("");
  338.     else
  339.         return(s);
  340. }
  341.  
  342. char *PASCAL NEAR getkill()    /* return some of the contents of the kill buffer */
  343.  
  344. {
  345.     register int size;    /* max number of chars to return */
  346.     char value[NSTRING];    /* temp buffer for value */
  347.  
  348.     if (kbufh == NULL)
  349.         /* no kill buffer....just a null string */
  350.         value[0] = 0;
  351.     else {
  352.         /* copy in the contents... */
  353.         if (kused < NSTRING)
  354.             size = kused;
  355.         else
  356.             size = NSTRING - 1;
  357.         bytecopy(value, kbufh->d_chunk, size);
  358.     }
  359.  
  360.     /* and return the constructed value */
  361.     return(value);
  362. }
  363.  
  364. char *PASCAL NEAR trimstr(s)    /* trim whitespace off the end of a string */
  365.  
  366. char *s;    /* string to trim */
  367.  
  368. {
  369.     char *sp;    /* backward index */
  370.  
  371.     sp = s + strlen(s) - 1;
  372.     while ((sp >= s) && (*sp == ' ' || *sp == '\t'))
  373.         --sp;
  374.     *(sp+1) = 0;
  375.     return(s);
  376. }
  377.  
  378. int PASCAL NEAR setvar(f, n)        /* set a variable */
  379.  
  380. int f;        /* default flag */
  381. int n;        /* numeric arg (can overide prompted value) */
  382.  
  383. {
  384.     register int status;    /* status return */
  385.     VDESC vd;        /* variable num/type */
  386.     char var[NVSIZE+1];    /* name of variable to fetch */
  387.     char value[NSTRING];    /* value to set variable to */
  388.  
  389.     /* first get the variable to set.. */
  390.     if (clexec == FALSE) {
  391.         status = mlreply(TEXT51, &var[0], NVSIZE+1);
  392. /*                               "Variable to set: " */
  393.         if (status != TRUE)
  394.             return(status);
  395.     } else {    /* macro line argument */
  396.         /* grab token and skip it */
  397.         execstr = token(execstr, var, NVSIZE + 1);
  398.     }
  399.  
  400.     /* check the legality and find the var */
  401.     findvar(var, &vd, NVSIZE + 1);
  402.     
  403.     /* if its not legal....bitch */
  404.     if (vd.v_type == -1) {
  405.         mlwrite(TEXT52, var);
  406. /*                      "%%No such variable as '%s'" */
  407.         return(FALSE);
  408.     }
  409.  
  410.     /* get the value for that variable */
  411.     if (f == TRUE)
  412.         strcpy(value, int_asc(n));
  413.     else {
  414.         status = mlreply(TEXT53, &value[0], NSTRING);
  415. /*                               "Value: " */
  416.         if (status != TRUE)
  417.             return(status);
  418.     }
  419.  
  420.     /* and set the appropriate value */
  421.     status = svar(&vd, value);
  422.  
  423. #if    DEBUGM
  424.     /* if $debug == TRUE, every assignment will echo a statment to
  425.        that effect here. */
  426.     
  427.     if (macbug && (strcmp(var, "%track") != 0)) {
  428.         strcpy(outline, "(((");
  429.  
  430.         strcat(outline, var);
  431.         strcat(outline, " <- ");
  432.  
  433.         /* and lastly the value we tried to assign */
  434.         strcat(outline, value);
  435.         strcat(outline, ")))");
  436.  
  437.         /* expand '%' to "%%" so mlwrite wont bitch */
  438.         makelit(outline);
  439.  
  440.         /* write out the debug line */
  441.         mlforce(outline);
  442.         update(TRUE);
  443.  
  444.         /* and get the keystroke to hold the output */
  445.         if (getkey() == abortc) {
  446.             mlforce(TEXT54);
  447. /*                              "[Macro aborted]" */
  448.             status = FALSE;
  449.         }
  450.     }
  451. #endif
  452.  
  453.     /* and return it */
  454.     return(status);
  455. }
  456.  
  457. PASCAL NEAR findvar(var, vd, size)    /* find a variables type and name */
  458.  
  459. char *var;    /* name of var to get */
  460. VDESC *vd;    /* structure to hold type and ptr */
  461. int size;    /* size of var array */
  462.  
  463. {
  464.     register int vnum;    /* subscript in varable arrays */
  465.     register int vtype;    /* type to return */
  466.  
  467. fvar:    vtype = -1;
  468.     switch (var[0]) {
  469.  
  470.         case '$': /* check for legal enviromnent var */
  471.             for (vnum = 0; vnum < NEVARS; vnum++)
  472.                 if (strcmp(&var[1], envars[vnum]) == 0) {
  473.                     vtype = TKENV;
  474.                     break;
  475.                 }
  476.             break;
  477.  
  478.         case '%': /* check for existing legal user variable */
  479.             for (vnum = 0; vnum < MAXVARS; vnum++)
  480.                 if (strcmp(&var[1], uv[vnum].u_name) == 0) {
  481.                     vtype = TKVAR;
  482.                     break;
  483.                 }
  484.             if (vnum < MAXVARS)
  485.                 break;
  486.  
  487.             /* create a new one??? */
  488.             for (vnum = 0; vnum < MAXVARS; vnum++)
  489.                 if (uv[vnum].u_name[0] == 0) {
  490.                     vtype = TKVAR;
  491.                     strcpy(uv[vnum].u_name, &var[1]);
  492.                     uv[vnum].u_value = NULL;
  493.                     break;
  494.                 }
  495.             break;
  496.  
  497.         case '&':    /* indirect operator? */
  498.             var[4] = 0;
  499.             if (strcmp(&var[1], "ind") == 0) {
  500.                 /* grab token, and eval it */
  501.                 execstr = token(execstr, var, size);
  502.                 strcpy(var, fixnull(getval(var)));
  503.                 goto fvar;
  504.             }
  505.     }
  506.  
  507.     /* return the results */
  508.     vd->v_num = vnum;
  509.     vd->v_type = vtype;
  510.     return;
  511. }
  512.  
  513. int PASCAL NEAR svar(var, value)    /* set a variable */
  514.  
  515. VDESC *var;    /* variable to set */
  516. char *value;    /* value to set to */
  517.  
  518. {
  519.     register int vnum;    /* ordinal number of var refrenced */
  520.     register int vtype;    /* type of variable to set */
  521.     register int status;    /* status return */
  522.     register int c;        /* translated character */
  523.     register char * sp;    /* scratch string pointer */
  524.  
  525.     /* simplify the vd structure (we are gonna look at it a lot) */
  526.     vnum = var->v_num;
  527.     vtype = var->v_type;
  528.  
  529.     /* and set the appropriate value */
  530.     status = TRUE;
  531.     switch (vtype) {
  532.     case TKVAR: /* set a user variable */
  533.         if (uv[vnum].u_value != NULL)
  534.             free(uv[vnum].u_value);
  535.         sp = malloc(strlen(value) + 1);
  536.         if (sp == NULL)
  537.             return(FALSE);
  538.         strcpy(sp, value);
  539.         uv[vnum].u_value = sp;
  540.         break;
  541.  
  542.     case TKENV: /* set an environment variable */
  543.         status = TRUE;    /* by default */
  544.         switch (vnum) {
  545.         case EVFILLCOL:    fillcol = asc_int(value);
  546.                 break;
  547.         case EVPAGELEN:    status = newsize(TRUE, asc_int(value));
  548.                 break;
  549.         case EVCURCOL:    status = setccol(asc_int(value));
  550.                 break;
  551.         case EVCURLINE:    status = gotoline(TRUE, asc_int(value));
  552.                 break;
  553.         case EVRAM:    break;
  554.         case EVFLICKER:    flickcode = stol(value);
  555.                 break;
  556.         case EVCURWIDTH:status = newwidth(TRUE, asc_int(value));
  557.                 break;
  558.         case EVCBFLAGS:    curbp->b_flag = (curbp->b_flag & ~(BFCHG|BFINVS))
  559.                     | (asc_int(value) & (BFCHG&BFINVS));
  560.                 lchange(WFMODE);
  561.                 break;
  562.         case EVCBUFNAME:strcpy(curbp->b_bname, value);
  563.                 curwp->w_flag |= WFMODE;
  564.                 break;
  565.         case EVCFNAME:    strcpy(curbp->b_fname, value);
  566.                 curwp->w_flag |= WFMODE;
  567.                 break;
  568.         case EVSRES:    status = TTrez(value);
  569.                 break;
  570.         case EVDEBUG:    macbug = stol(value);
  571.                 break;
  572.         case EVSTATUS:    cmdstatus = stol(value);
  573.                 break;
  574.         case EVPALETTE:    bytecopy(palstr, value, 48);
  575.                 spal(palstr);
  576.                 break;
  577.         case EVASAVE:    gasave = asc_int(value);
  578.                 break;
  579.         case EVACOUNT:    gacount = asc_int(value);
  580.                 break;
  581.         case EVLASTKEY:    lastkey = asc_int(value);
  582.                 break;
  583.         case EVCURCHAR:    ldelete(1L, FALSE);    /* delete 1 char */
  584.                 c = asc_int(value);
  585.                 if (c == '\r')
  586.                     lnewline(FALSE, 1);
  587.                 else
  588.                     linsert(1, c);
  589.                 backchar(FALSE, 1);
  590.                 break;
  591.         case EVDISCMD:    discmd = stol(value);
  592.                 break;
  593.         case EVVERSION:    break;
  594.         case EVPROGNAME:break;
  595.         case EVLANG:    break;
  596.         case EVSEED:    seed = asc_int(value);
  597.                 break;
  598.         case EVDISINP:    disinp = stol(value);
  599.                 break;
  600.         case EVWLINE:    status = resize(TRUE, asc_int(value));
  601.                 break;
  602.         case EVCWLINE:    status = forwline(TRUE,
  603.                         asc_int(value) - getwpos());
  604.                 break;
  605.         case EVTARGET:    curgoal = asc_int(value);
  606.                 thisflag = saveflag;
  607.                 break;
  608.         case EVSEARCH:    strcpy(pat, value);
  609.                 setjtable(pat); /* Set up fast search arrays  */
  610. #if    MAGIC
  611.                 mcclear();
  612. #endif
  613.                 break;
  614.         case EVTIME:    break;
  615.         case EVREPLACE:    strcpy(rpat, value);
  616.                 break;
  617.         case EVMATCH:    break;
  618.         case EVKILL:    break;
  619.         case EVREGION:    break;
  620.         case EVCMODE:    curbp->b_mode = asc_int(value);
  621.                 curwp->w_flag |= WFMODE;
  622.                 break;
  623.         case EVGMODE:    gmode = asc_int(value);
  624.                 break;
  625.         case EVTPAUSE:    term.t_pause = asc_int(value);
  626.                 break;
  627.         case EVPENDING:    break;
  628.         case EVLWIDTH:    break;
  629.         case EVLINE:    putctext(value);
  630.                 break;
  631.         case EVGFLAGS:    gflags = asc_int(value);
  632.                 break;
  633.         case EVRVAL:    break;
  634.         case EVREADHK:    setkey(&readhook, BINDFNC, value);
  635.                 break;
  636.         case EVWRAPHK:    setkey(&wraphook, BINDFNC, value);
  637.                 break;
  638.         case EVCMDHK:    setkey(&cmdhook, BINDFNC, value);
  639.                 break;
  640.         case EVXPOS:    xpos = asc_int(value);
  641.                 break;
  642.         case EVYPOS:    ypos = asc_int(value);
  643.                 break;
  644.         case EVSTERM:    sterm = stock(value);
  645.                 break;
  646.         case EVMODEFLAG:modeflag = stol(value);
  647.                 upwind();
  648.                 break;
  649.         case EVSSCROLL:    sscroll = stol(value);
  650.                 break;
  651.         case EVLASTMESG:strcpy(lastmesg, value);
  652.                 break;
  653.         case EVHARDTAB:    tabsize = asc_int(value);
  654.                 upwind();
  655.                 break;
  656.         case EVSOFTTAB:    stabsize = asc_int(value);
  657.                 upwind();
  658.                 break;
  659.         case EVSSAVE:    ssave = stol(value);
  660.                 break;
  661.         case EVFCOL:    curwp->w_fcol = asc_int(value);
  662.                 if (curwp->w_fcol < 0)
  663.                     curwp->w_fcol = 0;
  664.                 curwp->w_flag |= WFHARD | WFMODE;
  665.                 break;
  666.         case EVHSCROLL:    hscroll = stol(value);
  667.                 lbound = 0;
  668.                 break;
  669.         case EVHJUMP:    hjump = asc_int(value);
  670.                 if (hjump < 1)
  671.                     hjump = 1;
  672.                 if (hjump > term.t_ncol - 1)
  673.                     hjump = term.t_ncol - 1;
  674.                 break;
  675.         case EVBUFHOOK:    setkey(&bufhook, BINDFNC, value);
  676.                 break;
  677.         case EVEXBHOOK:    setkey(&exbhook, BINDFNC, value);
  678.                 break;
  679.         case EVWRITEHK:    setkey(&writehook, BINDFNC, value);
  680.                 break;
  681.         case EVDIAGFLAG:diagflag = stol(value);
  682.                 break;
  683.         case EVMSFLAG:    mouseflag = stol(value);
  684.                 break;
  685.         case EVOCRYPT:    oldcrypt = stol(value);
  686.                 break;
  687.         }
  688.         break;
  689.     }
  690.     return(status);
  691. }
  692.  
  693. /*    asc_int:    ascii string to integer......This is too
  694.         inconsistant to use the system's    */
  695.  
  696. PASCAL NEAR asc_int(st)
  697.  
  698. char *st;
  699.  
  700. {
  701.     int result;    /* resulting number */
  702.     int sign;    /* sign of resulting number */
  703.     char c;        /* current char being examined */
  704.  
  705.     result = 0;
  706.     sign = 1;
  707.  
  708.     /* skip preceding whitespace */
  709.     while (*st == ' ' || *st == '\t')
  710.         ++st;
  711.  
  712.     /* check for sign */
  713.     if (*st == '-') {
  714.         sign = -1;
  715.         ++st;
  716.     }
  717.     if (*st == '+')
  718.         ++st;
  719.  
  720.     /* scan digits, build value */
  721.     while ((c = *st++))
  722.         if (c >= '0' && c <= '9')
  723.             result = result * 10 + c - '0';
  724.         else
  725.             break;
  726.  
  727.     return(result * sign);
  728. }
  729.  
  730. /*    int_asc:    integer to ascii string.......... This is too
  731.             inconsistant to use the system's    */
  732.  
  733. char *PASCAL NEAR int_asc(i)
  734.  
  735. int i;    /* integer to translate to a string */
  736.  
  737. {
  738.     register int digit;        /* current digit being used */
  739.     register char *sp;        /* pointer into result */
  740.     register int sign;        /* sign of resulting number */
  741.     static char result[INTWIDTH+1];    /* resulting string */
  742.  
  743.     /* record the sign...*/
  744.     sign = 1;
  745.     if (i < 0) {
  746.         sign = -1;
  747.         i = -i;
  748.     }
  749.  
  750.     /* and build the string (backwards!) */
  751.     sp = result + INTWIDTH;
  752.     *sp = 0;
  753.     do {
  754.         digit = i % 10;
  755.         *(--sp) = '0' + digit;    /* and install the new digit */
  756.         i = i / 10;
  757.     } while (i);
  758.  
  759.     /* and fix the sign */
  760.     if (sign == -1) {
  761.         *(--sp) = '-';    /* and install the minus sign */
  762.     }
  763.  
  764.     return(sp);
  765. }
  766.  
  767. int PASCAL NEAR gettyp(token)    /* find the type of a passed token */
  768.  
  769. char *token;    /* token to analyze */
  770.  
  771. {
  772.     register char c;    /* first char in token */
  773.  
  774.     /* grab the first char (this is all we need) */
  775.     c = *token;
  776.  
  777.     /* no blanks!!! */
  778.     if (c == 0)
  779.         return(TKNUL);
  780.  
  781.     /* a numeric literal? */
  782.     if (c >= '0' && c <= '9')
  783.         return(TKLIT);
  784.  
  785.     switch (c) {
  786.         case '"':    return(TKSTR);
  787.  
  788.         case '!':    return(TKDIR);
  789.         case '@':    return(TKARG);
  790.         case '#':    return(TKBUF);
  791.         case '$':    return(TKENV);
  792.         case '%':    return(TKVAR);
  793.         case '&':    return(TKFUN);
  794.         case '*':    return(TKLBL);
  795.  
  796.         default:    return(TKCMD);
  797.     }
  798. }
  799.  
  800. char *PASCAL NEAR getval(token)    /* find the value of a token */
  801.  
  802. char *token;        /* token to evaluate */
  803.  
  804. {
  805.     register int status;    /* error return */
  806.     register BUFFER *bp;    /* temp buffer pointer */
  807.     register int blen;    /* length of buffer argument */
  808.     register int distmp;    /* temporary discmd flag */
  809.     static char buf[NSTRING];/* string buffer for some returns */
  810.  
  811.     switch (gettyp(token)) {
  812.         case TKNUL:    return("");
  813.  
  814.         case TKARG:    /* interactive argument */
  815.                 strcpy(token, fixnull(getval(&token[1])));
  816.                 distmp = discmd;    /* echo it always! */
  817.                 discmd = TRUE;
  818.                 status = getstring(token,
  819.                        buf, NSTRING, ctoec('\r'));
  820.                 discmd = distmp;
  821.                 if (status == ABORT)
  822.                     return(NULL);
  823.                 return(buf);
  824.  
  825.         case TKBUF:    /* buffer contents fetch */
  826.  
  827.                 /* grab the right buffer */
  828.                 strcpy(token, fixnull(getval(&token[1])));
  829.                 bp = bfind(token, FALSE, 0);
  830.                 if (bp == NULL)
  831.                     return(NULL);
  832.         
  833.                 /* if the buffer is displayed, get the window
  834.                    vars instead of the buffer vars */
  835.                 if (bp->b_nwnd > 0) {
  836.                     curbp->b_dotp = curwp->w_dotp;
  837.                     curbp->b_doto = curwp->w_doto;
  838.                 }
  839.  
  840.                 /* make sure we are not at the end */
  841.                 if (bp->b_linep == bp->b_dotp)
  842.                     return(NULL);
  843.         
  844.                 /* grab the line as an argument */
  845.                 blen = bp->b_dotp->l_used - bp->b_doto;
  846.                 if (blen > NSTRING)
  847.                     blen = NSTRING;
  848.                 bytecopy(buf, bp->b_dotp->l_text + bp->b_doto,
  849.                     blen);
  850.                 buf[blen] = 0;
  851.         
  852.                 /* and step the buffer's line ptr ahead a line */
  853.                 bp->b_dotp = bp->b_dotp->l_fp;
  854.                 bp->b_doto = 0;
  855.  
  856.                 /* if displayed buffer, reset window ptr vars*/
  857.                 if (bp->b_nwnd > 0) {
  858.                     curwp->w_dotp = curbp->b_dotp;
  859.                     curwp->w_doto = 0;
  860.                     curwp->w_flag |= WFMOVE;
  861.                 }
  862.  
  863.                 /* and return the spoils */
  864.                 return(buf);        
  865.  
  866.         case TKVAR:    return(gtusr(token+1));
  867.         case TKENV:    return(gtenv(token+1));
  868.         case TKFUN:    return(gtfun(token+1));
  869.         case TKDIR:    return(NULL);
  870.         case TKLBL:    return(NULL);
  871.         case TKLIT:    return(token);
  872.         case TKSTR:    return(token+1);
  873.         case TKCMD:    return(token);
  874.     }
  875. }
  876.  
  877. int PASCAL NEAR stol(val)    /* convert a string to a numeric logical */
  878.  
  879. char *val;    /* value to check for stol */
  880.  
  881. {
  882.     /* check for logical values */
  883.     if (val[0] == 'F')
  884.         return(FALSE);
  885.     if (val[0] == 'T')
  886.         return(TRUE);
  887.  
  888.     /* check for numeric truth (!= 0) */
  889.     return((asc_int(val) != 0));
  890. }
  891.  
  892. char *PASCAL NEAR ltos(val)    /* numeric logical to string logical */
  893.  
  894. int val;    /* value to translate */
  895.  
  896. {
  897.     if (val)
  898.         return(truem);
  899.     else
  900.         return(falsem);
  901. }
  902.  
  903. char *PASCAL NEAR mkupper(str)    /* make a string upper case */
  904.  
  905. char *str;        /* string to upper case */
  906.  
  907. {
  908.     char *sp;
  909.  
  910.     sp = str;
  911.     while (*sp)
  912.         uppercase(sp++);
  913.     return(str);
  914. }
  915.  
  916. char *PASCAL NEAR mklower(str)    /* make a string lower case */
  917.  
  918. char *str;        /* string to lower case */
  919.  
  920. {
  921.     char *sp;
  922.  
  923.     sp = str;
  924.     while (*sp)
  925.         lowercase(sp++);
  926.     return(str);
  927. }
  928.  
  929. int PASCAL NEAR absv(x)    /* take the absolute value of an integer */
  930.  
  931. int x;
  932.  
  933. {
  934.     return(x < 0 ? -x : x);
  935. }
  936.  
  937. int PASCAL NEAR ernd()    /* returns a random integer */
  938.  
  939. {
  940.     seed = absv(seed * 1721 + 10007);
  941.     return(seed);
  942. }
  943.  
  944. int PASCAL NEAR sindex(source, pattern)    /* find pattern within source */
  945.  
  946. char *source;    /* source string to search */
  947. char *pattern;    /* string to look for */
  948.  
  949. {
  950.     char *sp;    /* ptr to current position to scan */
  951.     char *csp;    /* ptr to source string during comparison */
  952.     char *cp;    /* ptr to place to check for equality */
  953.  
  954.     /* scanning through the source string */
  955.     sp = source;
  956.     while (*sp) {
  957.         /* scan through the pattern */
  958.         cp = pattern;
  959.         csp = sp;
  960.         while (*cp) {
  961.             if (!eq(*cp, *csp))
  962.                 break;
  963.             ++cp;
  964.             ++csp;
  965.         }
  966.  
  967.         /* was it a match? */
  968.         if (*cp == 0)
  969.             return((int)(sp - source) + 1);
  970.         ++sp;
  971.     }
  972.  
  973.     /* no match at all.. */
  974.     return(0);
  975. }
  976.  
  977. /*    Filter a string through a translation table    */
  978.  
  979. char *PASCAL NEAR xlat(source, lookup, trans)
  980.  
  981. char *source;    /* string to filter */
  982. char *lookup;    /* characters to translate */
  983. char *trans;    /* resulting translated characters */
  984.  
  985. {
  986.     register char *sp;    /* pointer into source table */
  987.     register char *lp;    /* pointer into lookup table */
  988.     register char *rp;    /* pointer into result */
  989.     static char result[NSTRING];    /* temporary result */
  990.  
  991.     /* scan source string */
  992.     sp = source;
  993.     rp = result;
  994.     while (*sp) {
  995.         /* scan lookup table for a match */
  996.         lp = lookup;
  997.         while (*lp) {
  998.             if (*sp == *lp) {
  999.                 *rp++ = trans[lp - lookup];
  1000.                 goto xnext;
  1001.             }
  1002.             ++lp;
  1003.         }
  1004.  
  1005.         /* no match, copy in the source char untranslated */
  1006.         *rp++ = *sp;
  1007.  
  1008. xnext:        ++sp;
  1009.     }
  1010.  
  1011.     /* terminate and return the result */
  1012.     *rp = 0;
  1013.     return(result);
  1014. }
  1015.  
  1016. #if    DEBUGM
  1017. int PASCAL NEAR dispvar(f, n)        /* display a variable's value */
  1018.  
  1019. int f;        /* default flag */
  1020. int n;        /* numeric arg (can overide prompted value) */
  1021.  
  1022. {
  1023.     register int status;    /* status return */
  1024.     VDESC vd;        /* variable num/type */
  1025.     char var[NVSIZE+1];    /* name of variable to fetch */
  1026.  
  1027.     /* first get the variable to display.. */
  1028.     if (clexec == FALSE) {
  1029.         status = mlreply(TEXT55, &var[0], NVSIZE+1);
  1030. /*                               "Variable to display: " */
  1031.         if (status != TRUE)
  1032.             return(status);
  1033.     } else {    /* macro line argument */
  1034.         /* grab token and skip it */
  1035.         execstr = token(execstr, var, NVSIZE + 1);
  1036.     }
  1037.  
  1038.     /* check the legality and find the var */
  1039.     findvar(var, &vd, NVSIZE + 1);
  1040.     
  1041.     /* if its not legal....bitch */
  1042.     if (vd.v_type == -1) {
  1043.         mlwrite(TEXT52, var);
  1044. /*                      "%%No such variable as '%s'" */
  1045.         return(FALSE);
  1046.     }
  1047.  
  1048.     /* and display the value */
  1049.     strcpy(outline, var);
  1050.     strcat(outline, " = ");
  1051.  
  1052.     /* and lastly the current value */
  1053.     strcat(outline, fixnull(getval(var)));
  1054.  
  1055.     /* expand '%' to "%%" so mlwrite wont bitch */
  1056.     makelit(outline);
  1057.  
  1058.     /* write out the result */
  1059.     mlforce(outline);
  1060.     update(TRUE);
  1061.  
  1062.     /* and return */
  1063.     return(TRUE);
  1064. }
  1065.  
  1066. /*    describe-variables    Bring up a fake buffer and list the contents
  1067.                 of all the environment variables
  1068. */
  1069.  
  1070. PASCAL NEAR desvars(f, n)
  1071.  
  1072. {
  1073.     register WINDOW *wp;    /* scanning pointer to windows */
  1074.     register BUFFER *bp;    /* buffer to put binding list into */
  1075.     register int uindex;    /* index into uvar table */
  1076.     register int cmark;    /* current mark */
  1077.     char outseq[80];    /* output buffer for keystroke sequence */
  1078.  
  1079.     /* split the current window to make room for the variable list */
  1080.     if (splitwind(FALSE, 1) == FALSE)
  1081.             return(FALSE);
  1082.  
  1083.     /* and get a buffer for it */
  1084.     bp = bfind(TEXT56, TRUE, 0);
  1085. /*                 "Variable list" */
  1086.     if (bp == NULL || bclear(bp) == FALSE) {
  1087.         mlwrite(TEXT57);
  1088. /*                      "Can not display variable list" */
  1089.         return(FALSE);
  1090.     }
  1091.  
  1092.     /* let us know this is in progress */
  1093.     mlwrite(TEXT58);
  1094. /*              "[Building variable list]" */
  1095.  
  1096.     /* disconect the current buffer */
  1097.         if (--curbp->b_nwnd == 0) {             /* Last use.            */
  1098.                 curbp->b_dotp  = curwp->w_dotp;
  1099.                 curbp->b_doto  = curwp->w_doto;
  1100.         for (cmark = 0; cmark < NMARKS; cmark++) {
  1101.                     curbp->b_markp[cmark] = curwp->w_markp[cmark];
  1102.                     curbp->b_marko[cmark] = curwp->w_marko[cmark];
  1103.                 }
  1104.         curbp->b_fcol  = curwp->w_fcol;
  1105.         }
  1106.  
  1107.     /* connect the current window to this buffer */
  1108.     curbp = bp;    /* make this buffer current in current window */
  1109.     bp->b_mode = 0;        /* no modes active in binding list */
  1110.     bp->b_nwnd++;        /* mark us as more in use */
  1111.     wp = curwp;
  1112.     wp->w_bufp = bp;
  1113.     wp->w_linep = bp->b_linep;
  1114.     wp->w_flag = WFHARD|WFFORCE;
  1115.     wp->w_dotp = bp->b_dotp;
  1116.     wp->w_doto = bp->b_doto;
  1117.     for (cmark = 0; cmark < NMARKS; cmark++) {
  1118.         wp->w_markp[cmark] = NULL;
  1119.         wp->w_marko[cmark] = 0;
  1120.     }
  1121.  
  1122.     /* build the environment variable list */
  1123.     for (uindex = 0; uindex < NEVARS; uindex++) {
  1124.  
  1125.         /* add in the environment variable name */
  1126.         strcpy(outseq, "$");
  1127.         strcat(outseq, envars[uindex]);
  1128.         pad(outseq, 14);
  1129.         
  1130.         /* add in the value */
  1131.         strcat(outseq, gtenv(envars[uindex]));
  1132.         strcat(outseq, "\r");
  1133.  
  1134.         /* and add it as a line into the buffer */
  1135.         if (linstr(outseq) != TRUE)
  1136.             return(FALSE);
  1137.     }
  1138.  
  1139.     linstr("\r\r");
  1140.  
  1141.     /* build the user variable list */
  1142.     for (uindex = 0; uindex < MAXVARS; uindex++) {
  1143.         if (uv[uindex].u_name[0] == 0)
  1144.             break;
  1145.  
  1146.         /* add in the user variable name */
  1147.         strcpy(outseq, "%");
  1148.         strcat(outseq, uv[uindex].u_name);
  1149.         pad(outseq, 14);
  1150.         
  1151.         /* add in the value */
  1152.         strcat(outseq, uv[uindex].u_value);
  1153.         strcat(outseq, "\r");
  1154.  
  1155.         /* and add it as a line into the buffer */
  1156.         if (linstr(outseq) != TRUE)
  1157.             return(FALSE);
  1158.     }
  1159.  
  1160.     curwp->w_bufp->b_mode |= MDVIEW;/* put this buffer view mode */
  1161.     curbp->b_flag &= ~BFCHG;    /* don't flag this as a change */
  1162.     wp->w_dotp = lforw(bp->b_linep);/* back to the beginning */
  1163.     wp->w_doto = 0;
  1164.     upmode();
  1165.     mlerase();    /* clear the mode line */
  1166.     return(TRUE);
  1167. }
  1168.  
  1169. /*    describe-functions    Bring up a fake buffer and list the
  1170.                 names of all the functions
  1171. */
  1172.  
  1173. PASCAL NEAR desfunc(f, n)
  1174.  
  1175. {
  1176.     register WINDOW *wp;    /* scanning pointer to windows */
  1177.     register BUFFER *bp;    /* buffer to put binding list into */
  1178.     register int uindex;    /* index into funcs table */
  1179.     register int cmark;    /* current mark */
  1180.     char outseq[80];    /* output buffer for keystroke sequence */
  1181.  
  1182.     /* split the current window to make room for the variable list */
  1183.     if (splitwind(FALSE, 1) == FALSE)
  1184.             return(FALSE);
  1185.  
  1186.     /* and get a buffer for it */
  1187.     bp = bfind(TEXT211, TRUE, 0);
  1188. /*                 "Function list" */
  1189.     if (bp == NULL || bclear(bp) == FALSE) {
  1190.         mlwrite(TEXT212);
  1191. /*                      "Can not display function list" */
  1192.         return(FALSE);
  1193.     }
  1194.  
  1195.     /* let us know this is in progress */
  1196.     mlwrite(TEXT213);
  1197. /*              "[Building function list]" */
  1198.  
  1199.     /* disconect the current buffer */
  1200.         if (--curbp->b_nwnd == 0) {             /* Last use.            */
  1201.                 curbp->b_dotp  = curwp->w_dotp;
  1202.                 curbp->b_doto  = curwp->w_doto;
  1203.         for (cmark = 0; cmark < NMARKS; cmark++) {
  1204.                     curbp->b_markp[cmark] = curwp->w_markp[cmark];
  1205.                     curbp->b_marko[cmark] = curwp->w_marko[cmark];
  1206.                 }
  1207.         curbp->b_fcol  = curwp->w_fcol;
  1208.         }
  1209.  
  1210.     /* connect the current window to this buffer */
  1211.     curbp = bp;    /* make this buffer current in current window */
  1212.     bp->b_mode = 0;        /* no modes active in binding list */
  1213.     bp->b_nwnd++;        /* mark us as more in use */
  1214.     wp = curwp;
  1215.     wp->w_bufp = bp;
  1216.     wp->w_linep = bp->b_linep;
  1217.     wp->w_flag = WFHARD|WFFORCE;
  1218.     wp->w_dotp = bp->b_dotp;
  1219.     wp->w_doto = bp->b_doto;
  1220.     for (cmark = 0; cmark < NMARKS; cmark++) {
  1221.         wp->w_markp[cmark] = NULL;
  1222.         wp->w_marko[cmark] = 0;
  1223.     }
  1224.  
  1225.     /* build the function list */
  1226.     for (uindex = 0; uindex < NFUNCS; uindex++) {
  1227.  
  1228.         /* add in the environment variable name */
  1229.         strcpy(outseq, "&");
  1230.         strcat(outseq, funcs[uindex]);
  1231.         strcat(outseq, "\r");
  1232.  
  1233.         /* and add it as a line into the buffer */
  1234.         if (linstr(outseq) != TRUE)
  1235.             return(FALSE);
  1236.     }
  1237.  
  1238.     linstr("\r");
  1239.  
  1240.     curwp->w_bufp->b_mode |= MDVIEW;/* put this buffer view mode */
  1241.     curbp->b_flag &= ~BFCHG;    /* don't flag this as a change */
  1242.     wp->w_dotp = lforw(bp->b_linep);/* back to the beginning */
  1243.     wp->w_doto = 0;
  1244.     upmode();
  1245.     mlwrite("");    /* clear the mode line */
  1246.     return(TRUE);
  1247. }
  1248.  
  1249. pad(s, len)    /* pad a string to indicated length */
  1250.  
  1251. char *s;    /* string to add spaces to */
  1252. int len;    /* wanted length of string */
  1253.  
  1254. {
  1255.     while (strlen(s) < len) {
  1256.         strcat(s, "          ");
  1257.         s[len] = 0;
  1258.     }
  1259. }
  1260. #endif
  1261.